home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 2 #6 / utv2n6s1.d64 / label magic (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  24KB  |  844 lines

  1. 0 rem  goto 6740: 07/30/88 @ 06:20:c64 exit @ 610/6180
  2. 10 rem -------------------------
  3. 20 rem ! authors: dave hammond !
  4. 30 rem !   and    * jim borden !
  5. 40 rem ! *by uptime magazine   !
  6. 50 rem -------------------------
  7. 60 :
  8. 70 goto 460:-skip subs!
  9. 80 rem--edit label subs--
  10. 90 forx=0to4:aa$(x)=z$:next:rem--fill w/blanks
  11. 100 xr=0:yc=0:cf=0:rem row=0 / col=0 /change flag =>1=cursor/2=text change
  12. 110 rem--main label input loop--
  13. 120 for qq=0to2:qq=.
  14. 130 if oc$(xr,yc)=""thenoc$(xr,yc)=" "
  15. 140 print"[146]"oc$(xr,yc)"[157]";
  16. 150 get a$:if a$="" goto 150
  17. 160 k=asc(a$)and127:if k=13 goto 250:rem cr
  18. 170 ifk=17 goto270:rem--up/down
  19. 180 ifk=20 goto320:rem--del/inst
  20. 190 ifk=29 goto380:rem--rt/lf
  21. 200 ifa$="[133]" goto430:rem--f1 key
  22. 210 ifk<32 then next:qq:--not valid!
  23. 220 if a$=chr$(34)then next:rem--no quotes allowed
  24. 230 cf=cf or 2:print""a$;:oc$(xr,yc)=a$:yc=yc+1:ifyc>29thenyc=yc-1:print"[157]";
  25. 240 next:qq
  26. 250 print""oc$(xr,yc):xr=xr+1:yc=0:printtab(5):if xr>4thenxr=0:print"[145][145][145][145][145]";
  27. 260 next:qq
  28. 270 ifa$="[145]"goto300:rem--cur up
  29. 280 print""oc$(xr,yc)"[157]";:xr=xr+1:ifxr=5thenxr=0:print"[145][145][145][145][145]";
  30. 290 next:qq
  31. 300 print""oc$(xr,yc)"[157][145]";:xr=xr-1:if xr<0then xr=4:print"";
  32. 310 next:qq
  33. 320 cf=cf or 1:if a$<>"[148]" goto 350:rem--del key!
  34. 330 print""oc$(xr,yc)"[157]";:for x=28toyc step-1:oc$(xr,x+1)=oc$(xr,x):next:oc$(xr,yc)=" ":printa$" [157][145]"
  35. 340 printtab(36)chr$(20)"[145]":printtab(yc+5);:next:qq
  36. 350 if yc=0then next:rem--ignore del
  37. 360 yc=yc-1:for x=ycto28:oc$(xr,x)=oc$(xr,x+1):next:oc$(xr,x)=" ":printa$"[145]"
  38. 370 printtab(34)chr$(148)"[157][157] [145]":printtab(yc+5);:next:qq
  39. 380 cf=cf or 1:ifa$="[157]"goto410 :rem--cur left
  40. 390 print""oc$(xr,yc);:yc=yc+1:ifyc>29thenyc=29:print"[157]";
  41. 400 next:qq
  42. 410 print""oc$(xr,yc)"[157][157]";:yc=yc-1:ifyc<0thenyc=0:print"";
  43. 420 next:qq
  44. 430 qq=9:next:print"[147][215]orking":forqq=0to4:aa$(qq)="":for x=0to29:aa$(qq)=aa$(qq)+oc$(qq,x):next:next:hp=0:x=fre(1):return:-to menu
  45. 440 :
  46. 450 rem -- start-up sequence --
  47. 460 print"[147]"chr$(8)chr$(142):rem--blank screen & uppercase
  48. 470 poke53280,0:poke53281,0:rem--black on lt. grey
  49. 480 gosub 6180:rem--initialize variables
  50. 490 gosub 5890:rem--display cover screen
  51. 495 poke 198,0
  52. 500 get a$:if a$<>chr$(13) then 500:rem--delay loop
  53. 510 print"[147]"chr$(14);:rem--lowercase
  54. 520 :
  55. 530 rem--main menu--
  56. 540 gosub 1010:rem--display menu
  57. 550 gosub 1270:rem--get keypress
  58. 560 mm=0
  59. 570 on key gosub 650, 740,830,920,1900
  60. 580 rem   file,label,lptr,info,exit
  61. 590 :
  62. 600 if xt and cm=128 then poke828,173:print"[147][152]";:end:--restore f'(NULL)s/full screen
  63. 610 if xt then sys uptime:rem--if exit flag then exit
  64. 620 goto 540:rem--main menu on no exit
  65. 630 :
  66. 640 rem--file mgmnt menu--
  67. 650 m=key:ec=3:at$="[146][158]"
  68. 660 gosub 1010:rem--display menu
  69. 670 gosub 1270:rem--get keypress
  70. 680 on key gosub 1950,1950,   1950,  1950,2710,1900
  71. 690 rem     load,save,scratch,rename, dir,exit
  72. 700 if (mm) then return
  73. 710 goto 660
  74. 720 :
  75. 730 rem--label mgmnt menu--
  76. 740 m=key
  77. 750 gosub 1010:rem--display menu
  78. 760 gosub 1270:rem--get keypress
  79. 770 on key gosub 3690,  3770,  3860,4070,4210,1900
  80. 780 rem    add,change,delete,list,sort,exit
  81. 790 if (mm) then return
  82. 800 goto 750
  83. 810 :
  84. 820 rem--printer menu--
  85. 830 m=key
  86. 840 gosub 1010:rem--display menu
  87. 850 gosub 1270:rem--get keypress
  88. 860 on key gosub 4720,4900,4930,1900
  89. 870 rem   block, one, all,exit
  90. 880 key=m:if (mm) then return
  91. 890 goto 830
  92. 900 :
  93. 910 rem--info & help menu--
  94. 920 m=key
  95. 930 gosub 1010:rem--display menu
  96. 940 gosub 1270:rem--get keypress
  97. 950 on key gosub 6810,7050,1900
  98. 960 rem    info,help,exit
  99. 970 if (mm) then return
  100. 980 goto 920
  101. 990 :
  102. 1000 rem--display menu--
  103. 1010 if hp=0 then hp=1:gosub 1170:rem--print header
  104. 1020 gosub 1220:rem--print cursor legend
  105. 1030 gosub 1100:rem--clear text area
  106. 1040 print"[158]";spc(sp(m));hd$(m);""
  107. 1050 for mn=1 to m(m)
  108. 1060 printspc(9)"";mn;"[157]. [158]";m$(m,mn);""
  109. 1070 next:return
  110. 1080 :
  111. 1090 rem--clear text area--
  112. 1100 print"";
  113. 1110 for c1=1 to cn
  114. 1120 print"                                       "
  115. 1130 next
  116. 1140 cn=17:return
  117. 1150 :
  118. 1160 rem--print header--
  119. 1170 print"[147]"spc(9)"[159][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  120. 1180 print "[192][192][192][192][192][192][192][192][192][179] [204]abel [205]agic 64/128 [171][192][192][192][192][192][192][192][192][192]";
  121. 1190 printspc(9)"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]":return
  122. 1200 :
  123. 1210 rem--print cursor legend--
  124. 1220 xr=21:yc=5:p=0:gosub 1510
  125. 1230 print"[159][213]se [195]ursor [213]p/[196]own[159] for [195]hoice"
  126. 1240 printspc(8)"  [213]se [210][197][212][213][210][206][159] to [211]elect  ":return
  127. 1250 :
  128. 1260 rem--make selection--
  129. 1270 xr=7:yc=8:gosub 1510:rem--position cursor
  130. 1280 :
  131. 1290 key=1:mr=7+2*(m(m)-1):print"[150][186][157]";
  132. 1300 get k$:if k$<>""goto 1300
  133. 1310 get k$:if k$=""goto 1310
  134. 1320 if k$=chr$(13)goto 1480
  135. 1330 if k$=chr$(145)goto 1410
  136. 1340 if k$<>chr$(17)goto 1310
  137. 1350 :
  138. 1360 rem--cursor down--
  139. 1370 xr=xr+2:key=key+1:if key>m(m)then key=1: xr=7
  140. 1380 goto 1440
  141. 1390 :
  142. 1400 rem--cursor up--
  143. 1410 xr=xr-2:key=key-1:if key=0 then key=m(m):xr=mr
  144. 1420 :
  145. 1430 rem--print cursor--
  146. 1440 print" ":gosub 1510:rem--pos cur
  147. 1450 print"[150][186][157]";:goto 1310
  148. 1460 :
  149. 1470 rem--selection made/exit
  150. 1480 return
  151. 1490 :
  152. 1500 rem--cur pos sub--
  153. 1510 printleft$("",xr+1);tab(yc);
  154. 1520 return :[for any commo(NULL)re!]
  155. 1530 :
  156. 1540 rem--kbd input sub--
  157. 1550 ct=0:t$="":cs$="[164][157]":printat$cs$;
  158. 1560 get k$:if k$<>""goto 1560
  159. 1570 get k$:if k$=""goto 1570
  160. 1580 if k$="?" or k$="*"goto1570:rem--no wildcards! (save, etc.)
  161. 1590 if k$=chr$(13)goto 1860
  162. 1600 if k$<>chr$(20)goto 1690
  163. 1610 :
  164. 1620 rem--delete a character--
  165. 1630 if ct=0 goto 1570
  166. 1640 if (m<>2)or(ct<>max) then print"[155] [157]";
  167. 1650 print"[157] [157]";cs$;
  168. 1660 ct=ct-1:t$=left$(t$,ct):goto 1570
  169. 1670 :
  170. 1680 rem--trap keys--
  171. 1690 if ct=max goto 1570
  172. 1700 if m<>2 then 1760:rem--not doing labels
  173. 1710 :
  174. 1720 if(k$>chr$(132))and(k$<chr$(141))goto 1860
  175. 1730 if(k$=chr$(17))or(k$=chr$(145))goto 1860
  176. 1740 if(k$=chr$(19))or(k$=chr$(147))then 1860
  177. 1750 :
  178. 1760 if m<>2 and k$=chr$(46)goto 1570
  179. 1770 if k$=chr$(34)goto 1570
  180. 1780 if k$<chr$(32)goto 1570
  181. 1790 if (k$>chr$(95))and(k$<chr$(193))goto 1570
  182. 1800 if k$>chr$(218)goto 1570
  183. 1810 :
  184. 1820 ct=ct+1:t$=t$+k$:printat$;k$;
  185. 1830 if ct<>max then printcs$;
  186. 1840 goto 1570
  187. 1850 :
  188. 1860 if (ct<>max)or(m<>2) then printat$" "
  189. 1870 return
  190. 1880 :
  191. 1890 rem--prepare to exit--
  192. 1900 xt=1
  193. 1910 if m<>0 then xt=0:m=0:mm=1
  194. 1920 return
  195. 1930 :
  196. 1940 rem--get filename--
  197. 1950 cn=20:gosub 1100:rem--clear text area
  198. 1960 print"";
  199. 1970 sp=int((40-len(m$(m,key)))/2)
  200. 1980 printspc(sp)"[158]"m$(m,key)""
  201. 1990 if key=2 and lf$<>"" then print"[195]urrent [198]ilename: "lf$"[157][157][157][157]    "
  202. 2000 :
  203. 2010 for x=1 to 2
  204. 2020 print"[158]"pr$(x);
  205. 2030 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  206. 2040 printspc(26)"[145][145]";
  207. 2050 max=12:gosub 1550:rem--kbd input
  208. 2060 if t$=""then x=2:next:return
  209. 2070 f$(x)=t$+".lbl"
  210. 2080 if (key<>4) then x=2
  211. 2090 next
  212. 2100 :
  213. 2110 on key gosub 2160,2350,   2520,  2610
  214. 2120 rem   load,save,scratch,rename
  215. 2130 return
  216. 2140 :
  217. 2150 rem--load a label file--
  218. 2160 open15,8,15,"i0"
  219. 2170 gosub 5850:rem--err ck
  220. 2180 if en<>0 then close15:gosub 5580:return
  221. 2190 :
  222. 2200 fl$=f$(1):open8,8,8,fl$
  223. 2210 gosub 5850:rem--err ck
  224. 2220 if en<>0 then close8:close15:fl$="":gosub 5580:return
  225. 2230 :
  226. 2240 input#8,mx
  227. 2250 for x=0tomx:fory=0to4:rem--5 lines(y),mx records(x)
  228. 2260 input#8,l$(x,y):next:next:rem--read records
  229. 2270 mx=mx+1:if mx=20 goto2290
  230. 2280 for x=xto19:for y=0to4:l$(x,y)="":next:next:rem--clear labels
  231. 2290 close8:gosub 5850:rem--err ck
  232. 2300 close15:mm=1:if en<>0 then fl$="":mm=0:gosub 5580
  233. 2310 if mm then m=0:lf$=fl$:rem--to main after load
  234. 2320 return
  235. 2330 :
  236. 2340 rem --save a label file--
  237. 2350 open15,8,15,"i0"
  238. 2360 gosub 5850:rem--err ck
  239. 2370 if en<>0 then close15:gosub 5580:return
  240. 2380 :
  241. 2390 if mx<1 then print"[206]o [210]ecords!":forx=0to999:next:close15:return
  242. 2400 fl$=f$(1):open8,8,8,fl$:go